home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / GETUPLOA.MOD < prev    next >
Encoding:
Text File  |  1987-09-17  |  8.8 KB  |  271 lines
  1. (*----------------------------------------------------------------------*)
  2. (*       Get_Upload_Protocol --- Get Upload File Transfer Protocol      *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Get_Upload_Protocol : Transfer_Type ;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Function:   Get_Upload_Protocol                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Gets file name and transfer protocol for upload.     *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Transtyp := Get_Upload_Protocol: Transfer_Type;               *)
  16. (*                                                                      *)
  17. (*     Remarks:                                                         *)
  18. (*                                                                      *)
  19. (*     Calls:    KeyPressed                                             *)
  20. (*               Async_Send                                             *)
  21. (*               Async_Receive                                          *)
  22. (*                                                                      *)
  23. (*----------------------------------------------------------------------*)
  24.  
  25. CONST
  26.    Ascii_Quit_Item    = 10;
  27.  
  28. VAR
  29.    Transfer_Kind : Transfer_Type;
  30.    Ascii_Menu    : Menu_Type;
  31.    I             : INTEGER;
  32.    J             : INTEGER;
  33.    Pacing_String : STRING[10];
  34.    Ch            : CHAR;
  35.    Get_FileName  : BOOLEAN;
  36.    AFile         : FILE;
  37.  
  38. (*----------------------------------------------------------------------*)
  39.  
  40. FUNCTION Yes_No_String( B: BOOLEAN ) : AnyStr;
  41.  
  42. BEGIN (* Yes_No_String *)
  43.  
  44.    IF B THEN
  45.       Yes_No_String := 'YES'
  46.    ELSE
  47.       Yes_No_String := 'NO';
  48.  
  49. END   (* Yes_No_String *);
  50.  
  51. (*----------------------------------------------------------------------*)
  52.  
  53. PROCEDURE Get_Ascii_Parameters;
  54.  
  55. VAR
  56.    Ascii_Done : BOOLEAN;
  57.    I          : INTEGER;
  58.    J          : INTEGER;
  59.  
  60. BEGIN (* Get_Ascii_Parameters *)
  61.  
  62.    Make_A_Menu( Ascii_Menu, Ascii_Quit_Item, 3, 10, 50, 21, Ascii_Quit_Item,
  63.                 'Ascii transfer parameters: ',
  64.                 ';;;;;;;;;Perform transfer;', TRUE );
  65.  
  66.    Ascii_Done := FALSE;
  67.  
  68.    REPEAT
  69.  
  70.       FOR I := 1 TO ( Ascii_Quit_Item - 1 ) DO
  71.          WITH Ascii_Menu.Menu_Entries[I] DO
  72.             CASE I OF
  73.  
  74.                1:  Menu_Item_Text := 'a) Character delay (ms) (now ' +
  75.                                      IToS( Ascii_Char_Delay ) + ')';
  76.  
  77.                2:  Menu_Item_Text := 'b) Line delay (ms) (now ' +
  78.                                      IToS( Ascii_Line_Delay ) + ')';
  79.  
  80.                3:  Menu_Item_Text := 'c) Pacing character (now Ascii ' +
  81.                                      IToS( ORD( Ascii_Pacing_Char ) ) + ')';
  82.  
  83.                4:  Menu_Item_Text := 'd) Send file as byte stream (now ' +
  84.                                      Yes_No_String( Ascii_Send_Asis ) + ')';
  85.  
  86.                5:  Menu_Item_Text := 'e) Packet length ' +
  87.                                      '(now ' + IToS( Ascii_Line_Size ) + ')';
  88.  
  89.                6:  BEGIN
  90.                       IF ( Ascii_CR_LF_String = CHR( CR ) ) THEN
  91.                          Menu_Item_Text := 'f) End line with CR only'
  92.                       ELSE
  93.                          Menu_Item_Text := 'f) End line with CR + LF';
  94.                    END;
  95.  
  96.                7:  Menu_Item_Text := 'g) Send empty line as blank (now ' +
  97.                                      Yes_No_String( Ascii_Send_Blank ) + ')';
  98.  
  99.                8:  Menu_Item_Text := 'h) Send ctrl-z at end of file (now ' +
  100.                                      Yes_No_String( Ascii_Use_CtrlZ ) + ')';
  101.  
  102.                9:  Menu_Item_Text := 'i) Display text transferred (now ' +
  103.                                      Yes_No_String( Ascii_Show_Text ) + ')';
  104.  
  105.             END (* CASE *);
  106.  
  107.       Menu_Display_Choices( Ascii_Menu );
  108.  
  109.       I := Menu_Get_Choice( Ascii_Menu , Dont_Erase_Menu );
  110.  
  111.       GoToXY( 2 , 12 );
  112.       ClrEol;
  113.  
  114.       CASE I OF
  115.  
  116.          1    : BEGIN
  117.                    WRITE('Enter intercharacter delay:' );
  118.                    IF Read_Number( Ascii_Char_Delay , TRUE , J ) THEN
  119.                       Ascii_Char_Delay := J;
  120.                 END;
  121.  
  122.          2    : BEGIN
  123.                    WRITE('Enter interline delay: ');
  124.                    IF Read_Number( Ascii_Line_Delay , TRUE , J ) THEN
  125.                       Ascii_Line_Delay := J;
  126.                 END;
  127.  
  128.          3    : BEGIN
  129.  
  130.                    WRITE('Enter pacing character: ');
  131.  
  132.                    Pacing_String := Write_Ctrls( Ascii_Pacing_Char );
  133.  
  134.                    Read_Edited_String( Pacing_String );
  135.  
  136.                    Pacing_String := Read_Ctrls( Pacing_String );
  137.  
  138.                    IF LENGTH( Pacing_String ) > 0 THEN
  139.                       Ascii_Pacing_Char := Pacing_String[1]
  140.                    ELSE
  141.                       Ascii_Pacing_Char := CHR( NUL );
  142.  
  143.                 END;
  144.  
  145.          4    : Ascii_Send_Asis := NOT Ascii_Send_Asis;
  146.  
  147.          5    : BEGIN
  148.                    WRITE('Enter packet length for stream transfer: ');
  149.                    IF Read_Number( Ascii_Line_Size , TRUE , J ) THEN
  150.                       Ascii_Line_Size := MAX( MIN( J , 255 ) , 1 );
  151.                 END;
  152.  
  153.          6    : BEGIN
  154.                    IF ( Ascii_CR_LF_String = CHR( CR ) ) THEN
  155.                       Ascii_CR_LF_String := CHR( CR ) + CHR( LF )
  156.                    ELSE
  157.                       Ascii_CR_LF_String := CHR( CR );
  158.                 END;
  159.  
  160.          7    : Ascii_Send_Blank := NOT Ascii_Send_Blank;
  161.  
  162.          8    : Ascii_Use_CtrlZ  := NOT Ascii_Use_CtrlZ;
  163.  
  164.          9    : Ascii_Show_Text  := NOT Ascii_Show_Text;
  165.  
  166.          ELSE
  167.             Ascii_Done := TRUE;
  168.  
  169.       END (* CASE *);
  170.  
  171.       GoToXY( 2 , 12 );
  172.       ClrEol;
  173.  
  174.    UNTIL ( Ascii_Done );
  175.  
  176.    IF Ascii_Send_Asis THEN
  177.       BEGIN
  178.          Ascii_Send_Blank      := FALSE;
  179.          Ascii_CR_LF_String[0] := #0;
  180.       END;
  181.  
  182.       (*$I-*)
  183.    CLOSE( Afile );
  184.       (*$I+*)
  185.                                    (* Remove this window            *)
  186.    Restore_Screen( Saved_Screen );
  187.    Reset_Global_Colors;
  188.  
  189. END   (* Get_Ascii_Parameters *);
  190.  
  191. (*----------------------------------------------------------------------*)
  192.  
  193. BEGIN (* Get_Upload_Protocol *)
  194.                                    (* Copy keyboard data before we screw *)
  195.                                    (* it up so we can get file name      *)
  196.  
  197.    Saved_Kbd_File_Name := Keyboard_Line;
  198.  
  199.                                    (* No file name yet *)
  200.    FileName[0]         := #0;
  201.                                    (* No protocol yet *)
  202.    Get_Upload_Protocol := None;
  203.                                    (* Display menu of transfer types *)
  204.                                    (* and get transfer kind.         *)
  205.  
  206.    Display_Transfer_Types( 'send', Transfer_Kind );
  207.  
  208.                                    (* Get file name to transfer *)
  209.  
  210.    Get_FileName := ( Transfer_Kind <> None );
  211.    IF ( Transfer_Kind = Kermit ) THEN
  212.       Get_FileName := FALSE;
  213.  
  214.    IF Get_FileName THEN
  215.       BEGIN
  216.  
  217.          GoToXY( 2 , 18 );
  218.          WRITE('Enter Filename.Ext: ');
  219.          GoToXY( 2 , 19 );
  220.          WRITE('>');
  221.          ClrEol;
  222.          IF Auto_Find_FileNames THEN
  223.             Get_Auto_File_Name( Saved_Kbd_File_Name , FileName );
  224.          Read_Edited_String(FileName);
  225.          WRITELN;
  226.  
  227.          IF ( LENGTH( FileName ) = 0 ) THEN
  228.             BEGIN
  229.                Restore_Screen( Saved_Screen );
  230.                Reset_Global_Colors;
  231.                EXIT;
  232.             END;
  233.  
  234.       END;
  235.                                    (* Check that file exists *)
  236.  
  237.    IF Single_File_Protocol[Transfer_Kind] THEN
  238.       BEGIN
  239.  
  240.          ASSIGN(AFile,FileName);
  241.             (*$I- *)
  242.          RESET(AFile);
  243.             (*$I+ *)
  244.  
  245.          IF ( Int24Result <> 0 ) THEN
  246.             BEGIN
  247.                Transfer_Kind := None;
  248.                WRITE('*** File not found, send cancelled ***');
  249.                DELAY( Two_Second_Delay );
  250.             END;
  251.  
  252.             (*$I-*)
  253.          CLOSE( AFile );
  254.             (*$I+*)
  255.  
  256.          I := Int24Result;
  257.  
  258.       END;
  259.                                    (* Remove this window            *)
  260.    Restore_Screen( Saved_Screen );
  261.    Reset_Global_Colors;
  262.                                    (* Get parameters for Ascii transfer *)
  263.  
  264.    IF ( Transfer_Kind = Ascii ) THEN
  265.       Get_Ascii_Parameters;
  266.                                    (* Return transfer protocol type *)
  267.  
  268.    Get_Upload_Protocol := Transfer_Kind;
  269.  
  270. END   (* Get_Upload_Protocol *);
  271.